home *** CD-ROM | disk | FTP | other *** search
- /*
- * Defines of bytecode junk
- */
-
- #ifndef _INTERPRET_H
- #define _INTERPRET_H
- /*****************************************/
- /* For debugging */
- #ifndef NODEBUG
- #define BC_BUG(x) x
- #define BC_BUG_EXP(x) x
- #else
- #define BC_BUG(x)
- #define BC_BUG_EXP(x) 0
- #endif
-
- #ifndef NODEBUG
- #define VCHECK(x) \
- (( (x)!=NULL && (((int) (x))&1==1)) \
- ? CallError(sp,"Dumb value",nil,NONCONTINUABLE) \
- : nil)
- #else
- #define VCHECK(x) 0
- #endif
-
-
- #ifdef COUNT_BYTES
- #define BC_COUNTER(x) x
- #else
- #define BC_COUNTER(x)
- #endif
-
- #define BC_PRESWITCH() \
- BC_BUG({ \
- fprintf(stderr,"{Doing: [%x, %x, %d] %d}\n",pc,sp,(int) (sp-oldsp),*pc); \
- oldsp=sp; \
- }) \
- BC_COUNTER(exec_counts[*pc]++);
-
- /* Global reference */
- #define GLOB_REF(n,m) \
- vref(statics[n],m)
-
-
- /* Stack hacking */
-
- #define NTH_REF(sp,n) (*((sp)-(n)))
-
- #define SET_NTH_REF(sp,n,v) (*((sp)-(n))=v)
-
- #define PUSH_VAL(sp,val) ((*(++sp)=val))
-
- #define POP_VALS(sp,n) ((sp) -= (n))
-
- #define PEEK_VAL(sp) (*(sp))
-
- #define TOP_VAL(sp) (*(sp--))
-
- #define SHOVE_VAL(sp,val) ((*(sp))=val)
-
- #define SET_STACK(sp,val) (sp)=(val);
-
- /* Environment hacking */
-
- #define ENV_NTH(e,depth) \
- counter=depth; \
- while (counter) \
- { \
- e=vref(e,0); \
- counter--; \
- VCHECK(e); \
- }
-
- #define ENV_REF(e,into,depth,dist) \
- ENV_NTH(e,depth) \
- into=vref(e,dist+1);
-
- #define SET_ENV_REF(e,depth,dist,val) \
- ENV_NTH(e,depth) \
- vref(e,dist+1)=val;
-
- #define MAKE_ENV(sp,size) \
- { \
- LispObject tmp; \
- /**/ \
- tmp=allocate_vector(sp+1, size+1); \
- vref(tmp,0)= PEEK_VAL(sp); \
- SHOVE_VAL(sp,tmp); \
- }
-
- /******************************/
- /* instruction stream hacking */
-
- typedef unsigned char bytecode;
-
- /* shoves arg into 'into' and updates pc */
- /* Should be a bit (read lots) cleverer */
- #define read_int_arg(into,stream) \
- into= (int)(*(stream++)); \
- into=(into<<8)+((int)(*(stream++))); \
- into=(into<<8)+((int)(*(stream++))); \
- into= *(stream++) ? -into: into; \
- BC_BUG(fprintf(stderr,"Read int: got: %d [%x]\n", into,into));
-
- #define read_short_arg(into,stream) /* NOT YET */ \
- into=1; stream+=2;
-
- #define read_sign_arg(into,stream) \
- into=(int)((char) *(stream++));
-
- #define read_byte_arg(into,stream) \
- into = *(stream++);
-
- #define skip_int_arg(pc) pc+=sizeof(int)
-
- #define next(stream) stream++;
-
- #define INC_PC(pc) (pc++)
-
- /* representation of BC on stack */
- #define PC_VAL_WIDTH 20
- #define PC_FLAG_WIDTH 2
- #define PC_FLAG 3
- #define PC_VECT_MASK ((1<<(PC_VAL_WIDTH+PC_FLAG_WIDTH)) - 1)
-
- #define bytevector_start(vector_number) (bytevectors[vector_number])
-
- #define REIFY_PC(pc) \
- ((LispObject) \
- ((this_vector<<(PC_VAL_WIDTH+PC_FLAG_WIDTH)) \
- | (((pc)-bytevector_start(this_vector)) << PC_FLAG_WIDTH) \
- | PC_FLAG))
-
- #define SET_PC(this_vector,reified_pc) \
- ((this_vector=((int)reified_pc)>>(PC_VAL_WIDTH+PC_FLAG_WIDTH)), \
- BC_BUG_EXP((this_vector==32 || this_vector==0) ? 0 : perror("wibble3")),\
- reified_pc=((LispObject) (((int)(reified_pc))&PC_VECT_MASK)), \
- bytevector_start(this_vector)+((((int)reified_pc)>>PC_FLAG_WIDTH)) \
- )
-
- /* modifies pc by x bytes */
- #define ADJUST_PC(pc,x) \
- ((pc)+((x)-1))
-
- #define BF2PC(x) \
- (this_vector=intval(bytefunction_codenum(x)), \
- BC_BUG_EXP(this_vector<=32 ? 0 : perror("wibble2")), \
- bytevector_start(intval(bytefunction_codenum(x))) \
- +intval(bytefunction_offset(x)))
-
- /* Move sp to the start of a new nary list */
-
-
- /**********************/
- /* Garbage protection */
-
- #define GC_RESTORE_GLOBALS \
- { \
- if (1) \
- { \
- BCnil=nil; \
- BCtrue=lisptrue; \
- } \
- }
-
- /* Printing counts ... */
- #ifdef COUNT_BYTES
- #define PRINT_COUNTS \
- { \
- int i,j; \
- for (i=0, j=0; i<256; i++) \
- { \
- if (exec_counts[i]!=0) \
- { \
- fprintf(stderr,"%3d: %7d ",i,exec_counts[i]); \
- j++; \
- if ( (j%6) == 0) \
- fputc('\n',stderr); \
- } \
- } \
- if (j%6!=0) fputc('\n',stderr); \
- }
- #else
- #define PRINT_COUNTS fprintf(stderr,"Count-bytes: Couldn't tell you\n");
- #endif
- /*****************************************/
- /* Interpreter macros */
- #define MAX_MODS 256
-
- #ifdef __STDC__
- # ifndef NODEBUG
- # define BC_CASE(name) \
- case name: fprintf(stderr,"{Exec: "#name" [%x]}",(int)name,(int)pc); name##_CODE break;
- # else
- # define BC_CASE(name)\
- case name: name##_CODE break;
- # endif
- #else /* stdc */
- # ifndef NODEBUG
- # define BC_CASE(name) \
- case name: fprintf(stderr,"{Exec: name [%x]}",(int)name,(int)pc); name/**/_CODE break;
-
- # else
- # define BC_CASE(name) \
- case name: name/**/_CODE \
- break
- # endif
- #endif
-
- #define N_GLOBALS 10
- #define GLOBAL_REF(n) vref(global_vector,(n))
- #define Generic_Lookup_Fn 0
- #define Generic_Apply_Fn 1
- #define Bci_Protect_Slot 2
-
- #define BC_GLOBALS() \
- static LispObject boot_modules[MAX_BOOT_MODULES]; \
- static int boot_module_count=1; \
- static bytecode exit_bytes[] = { BC_EXIT }; \
- static SYSTEM_GLOBAL(int,static_count); \
- static LispObject *statics; \
- static LispObject static_vectors; \
- static LispObject global_vector;
- /**/ \
- static bytecode **bytevectors; \
- BC_BUG(static LispObject *oldsp;) \
- BC_COUNTER(static int exec_counts[256];) \
-
- #define BC_INITIALISE_GLOBALS() \
- BCnil=nil; \
- BCtrue=lisptrue; \
- BC_BUG(oldsp=sp); \
- sp=stacktop-1; /* stackpointer[0]= top elt */ \
- pc=start_pc; \
- this_vector=context; \
-
- #define BC_NOINSTRUCT(pc) \
- default: \
- fprintf(stderr,"No such instruction: %d\n",pc);
-
- /* GC Protection */
- #define SAVE_REGISTERS(sp)
-
- #define RESTORE_REGISTERS(sp)
-
- #endif _INTERPRET_H
-